home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
rfix0312.zip
/
RSB30312.MRG
< prev
next >
Wrap
Text File
|
1993-03-12
|
19KB
|
437 lines
* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against C:\174\RBBSSUB3.BAS to produce D:\SOURCE\RBBSSUB3.BAS
* C:\174\RBBSSUB3.BAS: Date 6-20-1992 Size 129071 bytes
* ------------[ Created 03-12-1993 21:24:59 ]------------
* REPLACING old line(s) by new
20717 CALL FindItX (ZNodeWorkFile$,7)
ZUserIn$ = Desc$
WasX$ = DATE$
ZWasZ$ = LEFT$(WasX$,6) + _
RIGHT$(WasX$,2)
ZWasEN$ = ZPersonalDir$
NumPersonals = 0
IF NOT ZOK THEN _
GOTO 20718
UserFileIndexSave = ZUserFileIndex
UserRecordHold$ = ZUserRecord$
WHILE NOT EOF(7)
CALL ReadParmsX (7,ZWorkAra$(),2,1)
IF LEFT$(ZWorkAra$(1),4) <> "ALL " AND ZWorkAra$(1) <> "ALL" THEN _
NumPersonals = NumPersonals + 1 : _
UCat$ = ZWorkAra$(1) : _
* ------[ first line different ]------
GOSUB 20737 : _ ' KG082201
GOSUB 20728 : _
RcvrRecNum = VAL (ZWorkAra$(2)) : _
CALL SetUserFlag (RcvrRecNum,4096,"file")
WEND
CLOSE 7
IF NumPersonals > 0 THEN _
ZUserFileIndex = UserFileIndexSave : _
LSET ZUserRecord$ = UserRecordHold$ : _
GOTO 20723
* REPLACING old line(s) by new
20736 IF NOT ZOK THEN _
ZBytesInFile# = 0.0_
ELSE ZBytesInFile# = LOF(2)
IF ZBytesInFile# < 2.0 THEN _
EXIT SUB
* ------[ first line different ]------
RETURN ' KG082201
* INSERTING new line(s)
20737 CALL CheckInt (UCat$) ' KG082201
IF ZTestedIntValue > 0 THEN _ ' KG082201
UCat$ = " " + UCat$ ' KG082201
RETURN ' KG082201
END SUB
* REPLACING old line(s) by new
21623 CALL ReadParms (ZWorkAra$(),13,ZFF)
IF ZErrCode > 0 THEN _
ZFF = LEN(ZDefaultXfer$) : _
ZProtoPrompt$ = "None" : _
GOTO 21625
ZProtoPrompt$ = ZWorkAra$(1)
IF LEN(ZProtoPrompt$) > 2 THEN _
IF MID$(ZProtoPrompt$,2,1) = ")" THEN _
ZProtoPrompt$ = LEFT$(ZProtoPrompt$,1) + MID$(ZProtoPrompt$,3)
WasX = INSTR(ZProtoPrompt$+ZCrLf$,ZCrLf$)
ZProtoPrompt$ = LEFT$(ZProtoPrompt$,WasX-1)
CALL Trim (ZProtoPrompt$)
* ------[ first line different ]------
ZProtoMethod$ = ZWorkAra$(3) ' KG020501
CALL AllCaps (ZProtoMethod$)
ZReq8Bit = (LEFT$(ZWorkAra$(4),1) = "8")
ZDownTemplate$ = ZWorkAra$(12)
ZUpTemplate$ = ZWorkAra$(13)
WasX$ = ZWorkAra$(11)
WasX = INSTR(WasX$,"=")
ZAdvanceProtoWrite = ZFalse
IF WasX < 2 OR WasX >= LEN(WasX$) THEN _
ZFailureParm = 4 : _
ZFailureString$ = "F" _
ELSE ZFailureParm = VAL(LEFT$(WasX$,WasX-1)) : _
ZFailureString$ = MID$(WasX$,WasX+1) : _
WasX = INSTR(ZFailureString$,"=") : _
IF WasX > 0 THEN _
ZAdvanceProtoWrite = (MID$(ZFailureString$,WasX) = "=A") : _
ZFailureString$ = LEFT$(ZFailureString$,WasX-1)
ZProtoMacro$ = ZWorkAra$(10)
ZFakeXRpt = (LEFT$(ZWorkAra$(8),1) = "F")
ZBatchProto = (LEFT$(ZWorkAra$(6),1) = "B")
ZSpeedFactor! = VAL(ZWorkAra$(9))
IF ZSpeedFactor! < 0.1 THEN _
ZSpeedFactor! = 0.87
ZBlockSize = VAL(ZWorkAra$(7))
ZFLen = ZBlockSize
IF ZFLen < 1 THEN _
ZFLen = 128
* REPLACING old line(s) by new
43070 ZActiveMessageFile$ = ZOrigMsgFile$
ZSubParm = 3
CALL FileLock
CALL OpenMsg
FIELD 1, 128 AS ZMsgRec$
GET 1,ZNodeRecIndex
IF ZGlobalSysop THEN _
MID$(ZMsgRec$,1,30) = "SYSOP" + SPACE$(25)
MID$(ZMsgRec$,40,2) = STR$(ZExitToDoors)
MID$(ZMsgRec$,42,2) = STR$(ZEightBit)
MID$(ZMsgRec$,44,2) = RIGHT$(STR$(-ZBPS),2)
MID$(ZMsgRec$,46,2) = STR$(ZUpperCase)
MID$(ZMsgRec$,48,5) = MKS$(ZNumDnldBytes!) + MID$(STR$(-ZBatchTransfer),2)
MID$(ZMsgRec$,53,2) = STR$(ZWasGR)
MID$(ZMsgRec$,55,2) = STR$(ZSysop)
MID$(ZMsgRec$,65,3) = CHR$(VAL(LEFT$(ZOrigTimeLoggedOn$,2))) + _
CHR$(VAL(MID$(ZOrigTimeLoggedOn$,4,2))) + _
CHR$(VAL(MID$(ZOrigTimeLoggedOn$,7,2)))
MID$(ZMsgRec$,72,2) = STR$(ZPrivateDoor)
MID$(ZMsgRec$,74,1) = MID$(STR$(ZTransferFunction),2,1)
MID$(ZMsgRec$,75,1) = ZWasFT$
* ------[ first line different ]------
MID$(ZMsgRec$,113,2) = MKI$(CINT(ZTimeCredits!)/60) ' KG012803
MID$(ZMsgRec$,91,2) = STR$(ZReliableMode)
CALL BreakFileName (ZCurPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZFalse)
MID$(ZMsgRec$,93,8) = ZUserIn$ + SPACE$(8 - LEN(ZUserIn$))
IF ZLocalUser THEN _
ZWasZ$ = ZCarriageReturn$ + ZCarriageReturn$ _
ELSE ZWasZ$ = " 0"
MID$(ZMsgRec$,101,2) = ZWasZ$
MID$(ZMsgRec$,103,2) = STR$(ZLocalUserMode)
ZConfName$ = LEFT$(ZConfName$,INSTR(ZConfName$ + " "," ") - 1)
MID$(ZMsgRec$,105,8) = ZConfName$ + SPACE$(8 - LEN(ZConfName$))
MID$(ZMsgRec$,115,1) = MID$(STR$(ZAutoLogoffReq),2,1)
MID$(ZMsgRec$,117,2) = STR$(ZMenuIndex)
MID$(ZMsgRec$,119,2) = LEFT$(DATE$,2)
MID$(ZMsgRec$,121,2) = MID$(DATE$,4,2)
MID$(ZMsgRec$,123,2) = RIGHT$(DATE$,2)
MID$(ZMsgRec$,125,2) = LEFT$(TIME$,2)
MID$(ZMsgRec$,127,2) = MID$(TIME$,4,2)
' *** Save additional parameters for door restoral
CALL OpenOutW (ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
CALL PrintWorkA (STR$(ZLimitMinsPerSession))
CALL PrintWorkA (ZWasNG$)
CALL PrintWorkA (ZIndivValue$)
CALL PrintWorkA (ZOrigDateTimeOn$)
CALL PrintWorkA (ZOrigTimeLoggedOn$)
CALL PrintWorkA (STR$(ZUserFileIndex))
CALL PrintWorkA (ZUpldDir$)
ZOutTxt$ = STR$(ZUpldDir$ = ZFMSDirectory$ OR ZLimitSearchToFMS)
CALL PrintWorkA (ZOutTxt$)
CALL PrintWorkA (ZCBaud$)
CALL PrintWorkA (ZDooredTo$) ' KG012803
CLOSE 2
* REPLACING old line(s) by new
44000 ' $SUBTITLE: 'ReadProf - subroutine to restore a user profile'
' $PAGE
'
' NAME -- ReadProf
'
' INPUTS -- PARAMETER MEANING
' ZNodeRecIndex NODE RECORD TO USE
' ZSysopPswd1$ Sysop'S PSEUDONYM 1
' ZSysopPswd2$ Sysop'S PSEUDONYM 2
'
' OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
' UPON EXITING RBBS-PC TO A "DOOR"
'
' PURPOSE -- Reset a user's options and communications parameters
' that were saved in the node record when a user exited
' to a "door" so that he is in the same status as when
' he exited.
'
SUB ReadProf STATIC
FIELD 1, 128 AS ZMsgRec$
GET 1,ZNodeRecIndex
ZReliableMode = VAL(MID$(ZMsgRec$,91,2))
MID$(ZMsgRec$,40,2) = "00"
ZEightBit = VAL(MID$(ZMsgRec$,42,2))
ZBPS = -VAL(MID$(ZMsgRec$,44,2))
CALL CommInfo
ZBaudTest! = VAL(MID$(ZBaudRates$,(-5 * ZBPS),5))
ZUpperCase = VAL(MID$(ZMsgRec$,46,2))
ZNumDnldBytes! = CVS(MID$(ZMsgRec$,48,4))
ZBatchTransfer = (MID$(ZMsgRec$,52,1) = "1")
ZWasGR = VAL(MID$(ZMsgRec$,53,2))
HourLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,65,1))),2),2)
MinLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,66,1))),2),2)
SecLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,67,1))),2),2)
ZTimeLoggedOn$ = HourLoggedOn$ + _
":" + _
MinLoggedOn$ + _
":" + _
SecLoggedOn$
ZTransferFunction = VAL(MID$(ZMsgRec$,74,1))
ZWasFT$ = MID$(ZMsgRec$,75,1)
* ------[ first line different ]------
ZTimeCredits! = 60!*CVI(MID$(ZMsgRec$,113,2)) ' KG012803
ZMenuIndex = VAL(MID$(ZMsgRec$,117,2))
ZCurPUI$ = MID$(ZMsgRec$,93,8)
CALL Remove (ZCurPUI$," ")
IF ZCurPUI$ <> "" THEN _
CALL BreakFileName (ZMainPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZTrue) : _
ZCurPUI$ = ZOutTxt$ + ZCurPUI$ + ZWasZ$
ZCustomPUI = (ZCurPUI$ <> "")
ZLocalUser = (MID$(ZMsgRec$,101,2) = ZCarriageReturn$ + ZCarriageReturn$)
ZLocalUserMode = VAL(MID$(ZMsgRec$,103,2))
ZHomeConf$ = MID$(ZMsgRec$,105,8)
ZAutoLogoffReq = (VAL(MID$(ZMsgRec$,115,1)) <> 0)
CALL Trim (ZHomeConf$)
IF ZHomeConf$ = "MAIN" THEN _
ZHomeConf$ = ""
IF ZRequiredRings > 0 AND _
INSTR(ZModemInitCmd$,"S0=255") THEN _
COLOR 7,0,0 _
ELSE COLOR ZFG,ZBG,ZBorder
IF ZLocalUserMode THEN _
GOTO 44003
CALL SetBaud
* REPLACING old line(s) by new
44003 ZUserLogonTime! = VAL(HourLoggedOn$) * 3600! + _
VAL(MinLoggedOn$) * 60! + _
VAL(SecLoggedOn$)
HourLoggedOn$ = ""
MinLoggedOn$ = ""
SecLoggedOn$ = ""
IF ZMinsPerSession < 1 THEN _
ZMinsPerSession = 3
IF NOT ZEightBit THEN _
OUT ZLineCntlReg,&H1A
IF LEFT$(ZMsgRec$,7) = "SYSOP " THEN _
ZFirstName$ = ZSysopPswd1$ : _
ZActiveUserName$ = ZSecretName$ _
ELSE ZFirstNameEnd = INSTR(ZMsgRec$," ") : _
ZLastNameEnd = INSTR(ZFirstNameEnd + 1,ZMsgRec$ + " "," ") : _
ZFirstName$ = LEFT$(ZMsgRec$,ZFirstNameEnd-1) : _
ZLastName$ = MID$(ZMsgRec$,ZFirstNameEnd + 1,ZLastNameEnd - (ZFirstNameEnd + 1)) : _
ZActiveUserName$ = MID$(ZFirstName$ + " " + ZLastName$,1,31)
ZWasZ$ = ZFirstName$
CALL OpenWork (2,ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
CALL ReadDir (2,1)
ZLimitMinsPerSession = VAL (ZOutTxt$)
CALL ReadDir (2,1)
ZWasNG$ = ZOutTxt$
CALL ReadDir (2,1)
ZIndivValue$ = ZOutTxt$
CALL ReadDir (2,1)
ZOrigDateTimeOn$ = ZOutTxt$
CALL ReadDir (2,1)
ZOrigTimeLoggedOn$ = ZOutTxt$
CALL ReadDir (2,1)
ZUserFileIndex = VAL(ZOutTxt$)
CALL ReadDir (2,1)
ZUpldDoor$ = ZOutTxt$
CALL ReadDir (2,1)
ZFMSDoor = VAL(ZOutTxt$)
CALL ReadDir (2,1)
ZCBaud$ = ZOutTxt$
* ------[ first line different ]------
CALL ReadDir (2,1) ' KG012803
ZDooredTo$ = ZOutTxt$ ' KG012803
CLOSE 2
IF ZExitToDoors AND ZDooredTo$ <> "" THEN _ ' KG012803
CALL OpenWork (2,ZDoorsDef$) : _ ' KG012803
IF ZErrCode = 0 THEN _ ' KG012803
CALL ReadParms (ZOutTxt$(),8,1) : _ ' KG012803
WHILE ZErrCode = 0 AND ZOutTxt$(1) <> ZDooredTo$ : _ ' KG012803
CALL ReadParms (ZOutTxt$(),8,1) : _ ' KG012803
WEND : _ ' KG012803
IF ZOutTxt$(1) = ZDooredTo$ THEN _ ' KG012803
ZDoorSkipsPswd = (ZOutTxt$(6) <> "Y") ' KG012803
ZErrCode = 0 ' KG012803
CALL DoorReturn
END SUB
* REPLACING old line(s) by new
57100 IF INSTR(ZOutTxt$,"LOGON DENIED") OR INSTR(ZOutTxt$,"Lvl ")THEN _
IF NOT ZSysOp THEN _
RETURN
IF ZJumpSearching THEN _
ZWasDF$ = ZOutTxt$ : _
CALL AllCaps (ZWasDF$) : _
IF INSTR(ZWasDF$,ZJumpTo$) = 0 THEN _
RETURN _
ELSE CALL CheckColor (ZOutTxt$,ZJumpTo$,"") : _
ZJumpSearching = ZFalse
ZSubParm = 5
CALL TPut
WasX = 1
CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
* ------[ first line different ]------
IF ZSubParm = -1 THEN _ ' RH070402
GOTO 57102 _ ' RH070402
ELSE IF ZNo THEN _ ' RH070402
GOTO 57101 ' RH070402
RETURN
* REPLACING old line(s) by new
57102 ZJumpSupported = ZFalse
* ------[ first line different ]------
IF OrigCal$ <> ZCallersFile$ THEN _ ' RH070401
ZCallersFile$ = OrigCal$ : _
CALL SetCall
END SUB
* REPLACING old line(s) by new
58180 WasX$ = ZUserIn$(ZAnsIndex)
CALL AllCaps (WasX$)
IF InList AND (ZAnsIndex >= ZLastIndex OR WasX$ <> "D") THEN _
ZTurboKey = -ZTurboKeyUser : _
ZStackC = ZTrue : _
CALL AskMore (ExtraPrompt$, ZTrue, ZFalse,AbortIndex,ZFalse) : _
IF ZSubParm = -1 THEN _
EXIT SUB _
ELSE ZLastIndex = ZWasQ :_
IF NOT ZNo THEN _
ZAnsIndex = 1
IF ZSubParm = -1 THEN _
GOTO 58198
IF ZNo THEN _
ZLastIndex = 0 : _
GOTO 58198
WasX$ = ZUserIn$(ZAnsIndex)
CALL AllCaps (WasX$)
'print "WASX$=<";WASX$;"> zansindex=";zansindex;" zlastindex=";zlastindex;:for ii=zansindex to zlastindex: print "<";zuserin$(ii);">";:next:print:INPUT XXX$
* ------[ first line different ]------
'print "wasx$=<";wasx$;"> candnld=";candnld;" zlc=<";zlastcommand$;"> inlist=";inlist
* REPLACING old line(s) by new
58181 MarkingFiles = ZFalse
* ------[ first line different ]------
IF ((WasX$ = "D" OR WasX$ = "M") AND CanDnld) OR (WasX$ = "V" AND CanView) THEN _ ' KG091001
MarkingFiles = (WasX$ = "M") : _
CALL AskItems ("DMV",WasX$,ZTrue,"file",ZMarkedFiles$) : _ ' KG091001
IF ZWasQ = 0 THEN _
GOTO 58183
IF WasX$ = "*" THEN IF ZPersonalDnld THEN _
GOTO 58193
* REPLACING old line(s) by new
58183 IF ZJumpSearching THEN _
PrevSearch$ = SearchFor$ : _
SearchFor$ = ZJumpTo$ _
ELSE SearchFor$ = SearchString$ : _
IF NOT ZYes AND CanDnld THEN _
GOSUB 58188 : _
* ------[ first line different ]------
IF WasX$ = "V" AND CanView AND ZLastIndex >= ZAnsIndex THEN _ ' KG091001
ZAnsIndex = ZAnsIndex - 1 : _ ' KG091001
CALL GetArc : _ ' KG091001
ZJumpSupported = ZTrue : _ ' KG091001
ZWasA = UpldIndex : _ ' KG091001
GOSUB 58185 : _ ' KG091001
UpldIndex = ZWasA : _ ' KG091001
GOTO 58180 _ ' KG091001
ELSE IF WasX$ <> "L" AND ZLastIndex >= ZAnsIndex AND NOT MarkingFiles THEN _
CALL SkipLine (1) : _
DnldFlag = 1 : _
ReListAt = UpldIndex : _
EXIT SUB _ ' exit for downloading
ELSE IF UpldIndex = CutoffRec THEN _
GOTO 58184
IF ZNonStop THEN IF UpldIndex > 999 THEN _
IF (SearchDate$ = "" OR NOT ZExpertUser) THEN _
ZOutTxt$ = STR$(UpldIndex) + _
" lines left to search. Really go non-stop? (Y,[N])" : _
ZNoAdvance = ZTrue : _
ZTurboKey = -ZTurboKeyUser : _
ZSubParm = 1 : _
CALL TGet : _
CALL WipeLine (79) : _
ZNonStop = ZYes
GOTO 58168
* REPLACING old line(s) by new
58188 IF ProcessedNew OR MarkingFiles OR NOT ZListOnly THEN _
ProcessedNew = ZFalse : _
RETURN
ZUserIn$(0) = ""
WasI = ZAnsIndex ' check whether in dir
WHILE WasI <= ZLastIndex
CALL AraAllCaps (ZUserIn$(),WasI)
ZWasZ$ = ZUserIn$(WasI)
CALL UnMarkItems (ZMarkedFiles$,WasI,ZLastIndex,WasX,ZTrue)
Temp$ = ZUserIn$(WasI)
* ------[ first line different ]------
CALL AllCaps (Temp$) ' KG062401
'print "wasi=";wasi;" temp$=<";temp$;"> Zdef=<";zdefaultxfer$;">"
IsProto = (LEN(Temp$) = 1 AND _
INSTR(ZDefaultXfer$,Temp$) > 0)
ZOK = IsProto
WasJ = LastRec + 1
WasX = INSTR(Temp$,".")
AltTemp$ = ""
IF NOT IsProto THEN _
IF WasX = 0 THEN _
AltTemp$ = Temp$ + "." + ZDefaultExtension$ _
ELSE IF WasX = LEN(Temp$) THEN _
AltTemp$ = LEFT$(Temp$,WasX-1)
'print "58188 b4 while zok=";zok;" wasj=";wasj;" looking for <";temp$;">"
WHILE WasJ > 1 AND NOT ZOK
WasJ = WasJ - 1
GET #2,WasJ
GOSUB 58191
'print "bk 58191 canget=";catget;" ptp<";parttoprint$;">";:input xx$
IF CanGet THEN _
MID$(PartToPrint$,13,1) = " " : _
ZWasY$ = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1) : _ ' KG091001
ZOK = (Temp$ = ZWasY$) : _ ' KG091001
IF NOT ZOK THEN _
IF AltTemp$ <> "" THEN _
ZOK = (AltTemp$ = ZWasY$) ' KG091001
WEND
'print "58188 aft while zok=";zok;" wasj=";wasj;" looking for <";temp$;">":input xxx$
IF ZOK THEN _
GOSUB 58189 : _
IF ZOK OR IsProto THEN _
ZWasY$ = MID$(STR$(WasJ),2) : _ ' KG091001
ZUserIn$(0) = ZUserIn$(0) + _
ZWasY$ + _ ' KG091001
SPACE$(5 - LEN(ZWasY$)) ' KG091001
IF NOT ZOK AND NOT IsProto THEN _
CALL QuickTPut1 (ZWasZ$ + " not found - omitted") : _
FOR WasK = WasI + 1 TO ZLastIndex : _
ZUserIn$(WasK - 1) = ZUserIn$(WasK) : _
NEXT : _
ZLastIndex = ZLastIndex - 1 : _
WasI = WasI - 1
WasI = WasI + 1
WEND
ZWasQ = ZLastIndex
'print "end 58188 zlastindex=";zlastindex;" zok=";zok
RETURN
* REPLACING old line(s) by new
58196 CALL QuickTPut (ZEmphasizeOff$,0)
ZOutTxt$ = Temp$ + "L)ist,A)bort," + _
LEFT$("*)dnld new,",-11*ZPersonalDnld) + _
"M)ark" + LEFT$(",D)nld",-6*CanDnld) + _
LEFT$(",V)iew",-6*CanView) + ZPressEnterExpert$
ZTurboKey = -ZTurboKeyUser
CALL PopCmdStack
WasX$ = ZUserIn$(ZAnsIndex)
CALL AllCaps (WasX$)
IF WasX$ = "A" THEN ZRet = ZTrue
IF ZWasQ = 0 OR ZRet OR ZSubParm < 0 THEN _
GOTO 58198
IF WasX$ = "L" THEN _
ZActiveFMSDir$ = OrigDir$ : _
GOSUB 58185 : _
AtEndList = ZFalse : _
* ------[ first line different ]------
GOTO 58168 ' KG091001
ZYes = ZFalse
GOTO 58181